home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / Extras / SysGen / smart-id. < prev    next >
Encoding:
Text File  |  1989-09-13  |  1.4 KB  |  48 lines
  1. \ Check to make sure that an even address is
  2. \ a valid Name Field Address.
  3. \ Compare against all properties of a name field.
  4. \ It is possible but HIGHLY unlikely that
  5. \ this can fail.
  6.  
  7. \ MOD: PLB 9/13/89 Removed check for SMUDGE , this is mainly used
  8. \       by Clone which doesn't care about smudge bits.
  9.  
  10. : CHECK-NFA?   ( nfa? -- flag , check if a valid nfa )
  11.     dup 1 AND  ( odd address? )
  12. \ Check needed for Clone because >NAME can return an ODD address
  13. \ if its input is not a valid CFA.
  14.     IF drop false
  15.     ELSE 
  16.       ( precedence )
  17.       DUP C@   DUP $ 80 AND ( nfa? cnt? flag -- )
  18. \ ( ignore smudge bit )     OVER  $ 20 AND 0= AND
  19.       IF  TRUE SWAP    $ 01F AND  -dup
  20.         IF  0  ( -- nfa? flag cnt? 0 )
  21.           DO   ( nfa? flag2 --- )   SWAP 1+ DUP C@
  22.                ( f2 adr+1 <adr+1> -- )
  23.                dup $ 80 AND swap ?visible 0= or
  24.                IF   ( not an ascii char )    SWAP DROP FALSE  LEAVE
  25.                ELSE SWAP
  26.                THEN
  27.           LOOP ( adr flag -- )  SWAP DROP
  28.          ELSE 2drop false
  29.          THEN
  30.       ELSE 2DROP FALSE
  31.       THEN
  32.     THEN
  33. ;
  34.  
  35. : VALID-NAME?   ( nfa? -- flag , check if a valid name header )
  36.     dup check-nfa?
  37.     IF  n>link @ ?dup
  38.         IF ( prev-nfa? -- )
  39.             dup 1 and 0=
  40.             IF check-nfa?
  41.             ELSE drop FALSE
  42.             THEN
  43.         ELSE true  ( probably a vocabulary header )
  44.         THEN
  45.     ELSE drop FALSE
  46.     THEN
  47. ;
  48.